home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Gold Medal Software 3
/
Gold Medal Software - Volume 3 (Gold Medal) (1994).iso
/
utils2
/
paws2.arj
/
PAWS2.BAS
< prev
next >
Wrap
BASIC Source File
|
1994-01-01
|
6KB
|
216 lines
'********************************PAWS2.BAS*******************************
'
' Version 1.2
'1/1/94
'
'This program will run in the QuickBASIC environment and you can make
'stand-alone *.EXE files that permit you to use a mouse in a DOS program.
'When you start QuickBASIC, you MUST load the Quick Library QB.QLB
'so that you can CALL INTERRUPT.
'
'The command is:
'QB/L QB.QLB
'
'I have called this PAWS2.BAS (and the executable program PAWS2.COM)
'because it has two (2) PAUSE commands, keyboard and mouse.
'
'Please... please... no applause for the PAWS2 play on words as I
'am sure you know that a mouse has paws too (2?).
'
'
'And... if you want to disable your -Microsoft mouse-, just use the command:
'
'SHELL "mouse off"
'in the immediate window to disable the driver and run the program again.
'
'go to the SUB IsMouse(Yes%) and uncomment the error message lines to see
'what displays.
'
'run the program some more.
'
'SHELL "mouse on"
'to reset the software.
'
'This program evolved from Microsoft programs on the MSBASIC Forum of
'CompuServe. They really didn't explain -everything- so, I bought
'"Microsoft Mouse Programming Reference 2nd Edition," Microsoft Press 1991
'which cleared up a lot of questions and raised even more.
'
'This is a giant step forward, not for mankind, but for mouse users that
'want that mouse for QuickBASIC 4.5 use.
'
'John De Palma on CompuServe 76076,571
'
'1/1/94
'
DEFINT A-Z
CONST False = 0
CONST True = NOT False
'interrupt call for both INTERRUPT and INTERRUPTX
TYPE RegType
ax AS INTEGER
bx AS INTEGER
cx AS INTEGER
dx AS INTEGER
bp AS INTEGER
si AS INTEGER
di AS INTEGER
flags AS INTEGER
ds AS INTEGER
es AS INTEGER
END TYPE
'SUB name describes purpose and function
DECLARE SUB MouseBorder (UpperRow%, LeftCol%, LowerRow%, RightCol%)
DECLARE SUB MouseFunction (m1%, m2%, m3%, m4%)
DECLARE SUB ButtonStatus (m1%, m2%, m3%, m4%)
DECLARE SUB IsMouse (Yes%)
DECLARE SUB SetCursor (row%, col%)
DECLARE SUB ClearBuffer ()
DECLARE SUB ShowCursor (Hide%)
DECLARE SUB HideCursor (Hide%)
DECLARE SUB resetmouse ()
'executable code below
'COLOR 15, 1 'don't want these except for testing
'CLS
'a single line global function to center text
DEF FnCenter (text$) = 41 - (LEN(text$) \ 2)
'the next command places Copyright information into the *.COM file...
'just in case someone uses PAWS2.COM for commerical use as his own.
'it NEVER displays when the program runs.
Copyright$ = "∙Copyright∙(c)∙Sat,∙Jan∙1,∙1994∙John∙De∙Palma∙LearnWare∙"
'SCREEN 0 'these two commands clear the screen
'WIDTH 80 'don't want that
CALL IsMouse(Yes%)
IF Yes% THEN
PRINT "CLICK! or Press a key to Continue...";
row = CSRLIN
col = POS(0)
CALL SetCursor(row, col)
row2 = row
col2 = col + 2
CALL MouseBorder(row, col, row2, col2) 'fixes cursor position
ClearBuffer
DO
CALL ButtonStatus(m1, m2, m3, m4)
LOOP UNTIL LEN(INKEY$) OR m2 <> 0
'CALL HideCursor(Hide%) 'use this if doing more stuff
CALL resetmouse 'use this to end
ELSE
PRINT "Press a Key to Continue...";
ClearBuffer
WHILE INKEY$ = "": WEND
END IF
SUB ButtonStatus (m1, m2, m3, m4)
m1 = 3
CALL MouseFunction(m1, m2, m3, m4)
END SUB
SUB ClearBuffer
WHILE INKEY$ <> "": WEND
END SUB
SUB HideCursor (Hide%)
m1 = 2
CALL MouseFunction(m1, 0, 0, 0)
Hide% = Hide% + 1 'have to show cursor one more than
END SUB 'this number to see the cursor again
'tests for Mouse Software installed then Mouse Hardware.
'uncomment the lines to see error messages and mouse information.
SUB IsMouse (Yes%)
Yes% = True
DEF SEG = 0
MouseSegment& = 256& * PEEK(207) + PEEK(206)
MouseOffset& = 256& * PEEK(205) + PEEK(204)
DEF SEG = MouseSegment&
IF (MouseSegment& = 0 AND MouseOffset& = 0) OR PEEK(MouseOffset&) = 207 THEN
Yes% = False
MouseChecked = True
DEF SEG
'text$ = "Can't Find Mouse-Driver -> SOFTWARE!"
'LOCATE , FnCenter(text$)
'PRINT text$
EXIT SUB
END IF
m1 = 0 'mouse reset and status
CALL MouseFunction(m1, m2, 0, 0)
IF m1 THEN
'text$ = "A -" + LTRIM$(STR$(m2)) + "- BUTTON mouse is present"
'LOCATE , FnCenter(text$)
'PRINT text$
CALL ShowCursor(Hide%) 'show cursor
ELSE
'text$ = "Can't find Mouse-Driver - HARDWARE or Software!"
'LOCATE , FnCenter(text$)
'PRINT text$
Yes% = False
END IF
END SUB
SUB MouseBorder (UpperRow, LeftCol, LowerRow, RightCol) STATIC
UpperRow = (UpperRow - 1) * 8 'For SCREEN 0
LeftCol = (LeftCol - 1) * 8 'left upper corner is 0,0
LowerRow = (LowerRow - 1) * 8 'converting to pixels
RightCol = (RightCol - 1) * 8
CALL MouseFunction(7, 0, LeftCol, RightCol)
CALL MouseFunction(8, 0, UpperRow, LowerRow)
END SUB
SUB MouseFunction (m1%, m2%, m3%, m4%)
DIM Regs AS RegType
Regs.ax = m1
Regs.bx = m2
Regs.cx = m3
Regs.dx = m4
CALL INTERRUPT(&H33, Regs, Regs)
m1 = Regs.ax
m2 = Regs.bx
m3 = Regs.cx
m4 = Regs.dx
END SUB
SUB resetmouse
CALL MouseFunction(0, 0, 0, 0)
END SUB
SUB SetCursor (row%, col%) STATIC
m1 = 4
m3 = (col% - 1) * 8
m4 = (row% - 1) * 8
CALL MouseFunction(m1, 0, m3, m4)
END SUB
SUB ShowCursor (Hide%)
FOR i = Hide% TO Hide% + 1 'have to show once more than hide
m1 = 1 'ie, hide cursor twice, show thrice
CALL MouseFunction(m1, 0, 0, 0)
NEXT
END SUB